home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol061 / clock.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-13  |  13.5 KB  |  415 lines
  1. 0 '************************************************************
  2. 1 '*                                                          *
  3. 2 '*   Author:     Mike J. Sullivan  , Houston, Tx.           *
  4. 3 '*               12402 Campos Dr. ,Houston, Tx. 77065       *
  5. 4 '*   Date:       09/05/82                                   *
  6. 5 '*   Purpose:    Display your Basic Programs                *
  7. 6 '*   Title:      Digital Clock                              *
  8. 7 '*   Comment(s): enjoy                                      *
  9. 8 '*                                                          *
  10. 9 '************************************************************
  11. 10 KEY OFF
  12. 11 ODD = 0
  13. 12 Q15$ = "MbMLP14O4EO4CDO3G"
  14. 13 Q30$ = "MbMLP14O3GO4DEC"
  15. 15 CHIME = 0
  16. 20 LOCATE ,,0
  17. 21 '
  18. 22 ' Day of week / Date rollover for Mike Sullivan's digital clock
  19. 23 ' This code was merged into the original program already..
  20. 24 '      Day of week will be displayed;
  21. 25 ' day and date will change following 23:59:59.
  22. 26 ' You can also use the perpetual calendar routine in other programs.
  23. 27 ' Clayton Gaskill, Charlotte, NC
  24. 28 '       BASICA required!!!!!!!!!!
  25. 30 CLS
  26. 31 ' Tick and Tock for Mike Sullivan's Digital Clock. This merge was placed
  27. 32 ' into his clock to add tick,tock and Big Ben's chimes
  28. 33 ' Willis Frick, 8359 Amber Rose Lane, Rosemead, Ca. 91770,213 572 2738
  29. 35 ' The tick, tock and chimes will work with/without Clayton Gaskill
  30. 36 ' I have added all the enhancements to sullivans clock from these sources
  31. 37 ' Rich  Schinnell Capital PC Software Exchange, 1982 November 21
  32. 50 LOCATE 4,19:PRINT "          DIGITAL  CLOCK   1 . 1 0  "
  33. 60 GOSUB 4060
  34. 240 DIM ONE$(7),TWO$(7),THR$(7),FOU$(7),FIV$(7),COL$(7)
  35. 250 DIM SIX$(7),SEV$(7),EIG$(7),NIN$(7),ZER$(7),TEMP$(7)
  36. 260 XH1=.1:XH2=.1:XM1=.1:XM2=.2:XS1=.1:XS2=.1
  37. 270 COL$(1)="  "
  38. 280 COL$(2)="  "
  39. 290 COL$(3)=STRING$(2,CHR$(219))
  40. 300 COL$(4)="  "
  41. 310 COL$(5)=STRING$(2,CHR$(219))
  42. 320 COL$(6)="  "
  43. 330 COL$(7)="  "
  44. 340 ONE$(1)="  "+STRING$(3,CHR$(219))+"   "
  45. 350 ONE$(2)="   "+CHR$(219)+CHR$(219)+"   "
  46. 360 ONE$(3)="   "+CHR$(219)+CHR$(219)+"   "
  47. 370 ONE$(4)="   "+CHR$(219)+CHR$(219)+"   "
  48. 380 ONE$(5)="   "+CHR$(219)+CHR$(219)+"   "
  49. 390 ONE$(6)="   "+CHR$(219)+CHR$(219)+"   "
  50. 400 ONE$(7)=" "+STRING$(6,CHR$(219))+" "
  51. 410 TWO$(1)=STRING$(8,CHR$(219))
  52. 420 TWO$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  53. 430 TWO$(3)="      "+CHR$(219)+CHR$(219)
  54. 440 TWO$(4)=STRING$(8,CHR$(219))
  55. 450 TWO$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  56. 460 TWO$(5)=CHR$(219)+CHR$(219)+"      "
  57. 470 TWO$(7)=STRING$(8,CHR$(219))
  58. 480 THR$(1)=STRING$(8,CHR$(219))
  59. 490 THR$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  60. 500 THR$(3)="      "+CHR$(219)+CHR$(219)
  61. 510 THR$(4)=STRING$(8,CHR$(219))
  62. 520 THR$(5)="      "+CHR$(219)+CHR$(219)
  63. 530 THR$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  64. 540 THR$(7)=STRING$(8,CHR$(219))
  65. 550 FOU$(1)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  66. 560 FOU$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  67. 570 FOU$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  68. 580 FOU$(4)=STRING$(8,CHR$(219))
  69. 590 FOU$(6)="      "+CHR$(219)+CHR$(219)
  70. 600 FOU$(5)="      "+CHR$(219)+CHR$(219)
  71. 610 FOU$(7)="      "+CHR$(219)+CHR$(219)
  72. 620 FIV$(1)=STRING$(8,CHR$(219))
  73. 630 FIV$(2)=CHR$(219)+CHR$(219)+"      "
  74. 640 FIV$(3)=CHR$(219)+CHR$(219)+"      "
  75. 650 FIV$(4)=STRING$(8,CHR$(219))
  76. 660 FIV$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  77. 670 FIV$(5)="      "+CHR$(219)+CHR$(219)
  78. 680 FIV$(7)=STRING$(8,CHR$(219))
  79. 690 SIX$(1)=STRING$(8,CHR$(219))
  80. 700 SIX$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  81. 710 SIX$(3)=CHR$(219)+CHR$(219)+"      "
  82. 720 SIX$(4)=STRING$(8,CHR$(219))
  83. 730 SIX$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  84. 740 SIX$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  85. 750 SIX$(7)=STRING$(8,CHR$(219))
  86. 760 SEV$(1)=STRING$(8,CHR$(219))
  87. 770 SEV$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  88. 780 SEV$(3)="      "+CHR$(219)+CHR$(219)
  89. 790 SEV$(4)="      "+CHR$(219)+CHR$(219)
  90. 800 SEV$(5)="      "+CHR$(219)+CHR$(219)
  91. 810 SEV$(6)="      "+CHR$(219)+CHR$(219)
  92. 820 SEV$(7)="      "+CHR$(219)+CHR$(219)
  93. 830 EIG$(1)=STRING$(8,CHR$(219))
  94. 840 EIG$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  95. 850 EIG$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  96. 860 EIG$(4)=STRING$(8,CHR$(219))
  97. 870 EIG$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  98. 880 EIG$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  99. 890 EIG$(7)=STRING$(8,CHR$(219))
  100. 900 NIN$(1)=STRING$(8,CHR$(219))
  101. 910 NIN$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  102. 920 NIN$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  103. 930 NIN$(4)=CHR$(219)+STRING$(7,CHR$(219))
  104. 940 NIN$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  105. 950 NIN$(5)="      "+CHR$(219)+CHR$(219)
  106. 960 NIN$(7)=STRING$(8,CHR$(219))
  107. 970 ZER$(1)=STRING$(8,CHR$(219))
  108. 980 ZER$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  109. 990 ZER$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  110. 1000 ZER$(4)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  111. 1010 ZER$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  112. 1020 ZER$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  113. 1030 ZER$(7)=CHR$(219)+STRING$(7,CHR$(219))
  114. 1040 H1=VAL(MID$(TIME$,1,1))
  115. 1050 H2=VAL(MID$(TIME$,2,1))
  116. 1060 M1=VAL(MID$(TIME$,4,1))
  117. 1070 M2=VAL(MID$(TIME$,5,1))
  118. 1080 S1=VAL(MID$(TIME$,7,1))
  119. 1090 S2=VAL(MID$(TIME$,8,1))
  120. 1095 XDA$=MID$(DATE$,4,2)
  121. 1100 Z$=INKEY$:IF Z$="" THEN 1101 ELSE END
  122. 1101 MIN = VAL(MID$(TIME$,4,2))
  123. 1102 HOUR = VAL(MID$(TIME$,1,2))
  124. 1103 IF HOUR = 0 THEN HOUR = 12
  125. 1104 IF CHIME = 1 AND MIN = 0 THEN GOSUB 10090
  126. 1105 IF CHIME = 1 AND MIN = 15 THEN GOSUB 10090
  127. 1106 IF CHIME = 1 AND MIN = 30 THEN GOSUB 10090
  128. 1107 IF CHIME = 1 AND MIN = 45 THEN GOSUB 10090
  129. 1108 IF (MIN = 14) OR (MIN = 29) OR (MIN = 44) OR (MIN = 59) OR (MIN = 16) OR (MIN = 31) OR (MIN = 46) OR (MIN = 1) THEN CHIME = 1
  130. 1110 IF S2=XS2 THEN 1040
  131. 1111 GOSUB 10000
  132. 1115 IF DA$<>XDA$ THEN GOSUB 4060
  133. 1120 IF H1=0 THEN 1130 ELSE 1170
  134. 1130 IF H1=XH1 THEN 1450 ELSE XH1=H1
  135. 1140 FOR I=1 TO 7
  136. 1150 TEMP$(I)=ZER$(I):NEXT I
  137. 1160 GOSUB 3100:GOTO 1450
  138. 1170 IF H1=XH1 THEN 1450 ELSE XH1=H1
  139. 1180 ON H1 GOTO 1190,1220,1250,1280,1310,1340,1370,1400,1430
  140. 1190 FOR I=1 TO 7
  141. 1200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3100
  142. 1210 GOTO 1450
  143. 1220 FOR I=1 TO 7
  144. 1230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3100
  145. 1240 GOTO 1450
  146. 1250 FOR I=1 TO 7
  147. 1260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3100
  148. 1270 GOTO 1450
  149. 1280 FOR I=1 TO 7
  150. 1290 TEMP$(I)=FOU$(I):NEXT I:GOSUB300
  151. 1300 GOTO 1450
  152. 1310 FOR I=1 TO 7
  153. 1320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3100
  154. 1330 GOTO 1450
  155. 1340 FOR I=1 TO 7
  156. 1350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3100
  157. 1360 GOTO 1450
  158. 1370 FOR I=1 TO 7
  159. 1380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3100
  160. 1390 GOTO 1450
  161. 1400 FOR I=1 TO 7
  162. 1410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3100
  163. 1420 GOTO 1450
  164. 1430 FOR I=1 TO 7
  165. 1440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3100
  166. 1450 IF H2=0 THEN 1460 ELSE 1500
  167. 1460 IF H2=XH2 THEN 1790 ELSE XH2=H2
  168. 1470 FOR I=1 TO 7
  169. 1480 TEMP$(I)=ZER$(I):NEXT I
  170. 1490 GOSUB 3140:GOTO 1790
  171. 1500 IF H2=XH2 THEN 1790 ELSE XH2=H2
  172. 1510 ON H2 GOTO 1520,1550,1580,1610,1640,1670,1700,1730,1760
  173. 1520 FOR I=1 TO 7
  174. 1530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3140
  175. 1540 GOTO 1790
  176. 1550 FOR I=1 TO 7
  177. 1560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3140
  178. 1570 GOTO 1790
  179. 1580 FOR I=1 TO 7
  180. 1590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3140
  181. 1600 GOTO 1790
  182. 1610 FOR I=1 TO 7
  183. 1620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3140
  184. 1630 GOTO 1790
  185. 1640 FOR I=1 TO 7
  186. 1650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3140
  187. 1660 GOTO 1790
  188. 1670 FOR I=1 TO 7
  189. 1680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3140
  190. 1690 GOTO 1790
  191. 1700 FOR I=1 TO 7
  192. 1710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3140
  193. 1720 GOTO 1790
  194. 1730 FOR I=1 TO 7
  195. 1740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3140
  196. 1750 GOTO 1790
  197. 1760 FOR I=1 TO 7
  198. 1770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3140
  199. 1780 GOTO 3090
  200. 1790 IF M1=0 THEN 1800 ELSE 1840
  201. 1800 IF M1=XM1 THEN 2120 ELSE XM1=M1
  202. 1810 FOR I=1 TO 7
  203. 1820 TEMP$(I)=ZER$(I):NEXT I
  204. 1830 GOSUB 3210:GOTO 2120
  205. 1840 IF M1=XM1 THEN 2120 ELSE XM1=M1
  206. 1850 ON M1 GOTO 1860,1890,1920,1950,1980,2010,2040,2070,2100
  207. 1860 FOR I=1 TO 7
  208. 1870 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3210
  209. 1880 GOTO 2120
  210. 1890 FOR I=1 TO 7
  211. 1900 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3210
  212. 1910 GOTO 2120
  213. 1920 FOR I=1 TO 7
  214. 1930 TEMP$(I)=THR$(I):NEXT I:GOSUB 3210
  215. 1940 GOTO 2120
  216. 1950 FOR I=1 TO 7
  217. 1960 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3210
  218. 1970 GOTO 2120
  219. 1980 FOR I=1 TO 7
  220. 1990 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3210
  221. 2000 GOTO 2120
  222. 2010 FOR I=1 TO 7
  223. 2020 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3210
  224. 2030 GOTO 2120
  225. 2040 FOR I=1 TO 7
  226. 2050 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3210
  227. 2060 GOTO 2120
  228. 2070 FOR I=1 TO 7
  229. 2080 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3210
  230. 2090 GOTO 2120
  231. 2100 FOR I=1 TO 7
  232. 2110 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3210
  233. 2120 IF M2=0 THEN 2130 ELSE 2170
  234. 2130 IF M2=XM2 THEN 2450 ELSE XM2=M2
  235. 2140 FOR I=1 TO 7
  236. 2150 TEMP$(I)=ZER$(I):NEXT I
  237. 2160 GOSUB 3250:GOTO 2450
  238. 2170 IF M2=XM2 THEN 2450 ELSE XM2=M2
  239. 2180 ON M2 GOTO 2190,2220,2250,2280,2310,2340,2370,2400,2430
  240. 2190 FOR I=1 TO 7
  241. 2200 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3250
  242. 2210 GOTO 2450
  243. 2220 FOR I=1 TO 7
  244. 2230 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3250
  245. 2240 GOTO 2450
  246. 2250 FOR I=1 TO 7
  247. 2260 TEMP$(I)=THR$(I):NEXT I:GOSUB 3250
  248. 2270 GOTO 2450
  249. 2280 FOR I=1 TO 7
  250. 2290 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3250
  251. 2300 GOTO 2450
  252. 2310 FOR I=1 TO 7
  253. 2320 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3250
  254. 2330 GOTO 2450
  255. 2340 FOR I=1 TO 7
  256. 2350 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3250
  257. 2360 GOTO 2450
  258. 2370 FOR I=1 TO 7
  259. 2380 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3250
  260. 2390 GOTO 2450
  261. 2400 FOR I=1 TO 7
  262. 2410 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3250
  263. 2420 GOTO 2450
  264. 2430 FOR I=1 TO 7
  265. 2440 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3250
  266. 2450 IF S1=0 THEN 2460 ELSE 2500
  267. 2460 IF S1=XS1 THEN 2780 ELSE XS1=S1
  268. 2470 FOR I=1 TO 7
  269. 2480 TEMP$(I)=ZER$(I):NEXT I
  270. 2490 GOSUB 3320:GOTO 2780
  271. 2500 IF S1=XS1 THEN 2780 ELSE XS1=S1
  272. 2510 ON S1 GOTO 2520,2550,2580,2610,2640,2670,2700,2730,2760
  273. 2520 FOR I=1 TO 7
  274. 2530 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3320
  275. 2540 GOTO 2780
  276. 2550 FOR I=1 TO 7
  277. 2560 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3320
  278. 2570 GOTO 2780
  279. 2580 FOR I=1 TO 7
  280. 2590 TEMP$(I)=THR$(I):NEXT I:GOSUB 3320
  281. 2600 GOTO 2780
  282. 2610 FOR I=1 TO 7
  283. 2620 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3320
  284. 2630 GOTO 2780
  285. 2640 FOR I=1 TO 7
  286. 2650 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3320
  287. 2660 GOTO 2780
  288. 2670 FOR I=1 TO 7
  289. 2680 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3320
  290. 2690 GOTO 2780
  291. 2700 FOR I=1 TO 7
  292. 2710 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3320
  293. 2720 GOTO 2780
  294. 2730 FOR I=1 TO 7
  295. 2740 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3320
  296. 2750 GOTO 2780
  297. 2760 FOR I=1 TO 7
  298. 2770 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3320
  299. 2780 IF S2=0 THEN 2790 ELSE 2820
  300. 2790 FOR I=1 TO 7
  301. 2800 TEMP$(I)=ZER$(I):NEXT I
  302. 2810 GOSUB 3360:GOTO 3090
  303. 2820 XS2=S2:ON S2 GOTO 2830,2860,2890,2920,2950,2980,3010,3040,3070
  304. 2830 FOR I=1 TO 7
  305. 2840 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3360
  306. 2850 GOTO 3090
  307. 2860 FOR I=1 TO 7
  308. 2870 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3360
  309. 2880 GOTO 3090
  310. 2890 FOR I=1 TO 7
  311. 2900 TEMP$(I)=THR$(I):NEXT I:GOSUB 3360
  312. 2910 GOTO 3090
  313. 2920 FOR I=1 TO 7
  314. 2930 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3360
  315. 2940 GOTO 3090
  316. 2950 FOR I=1 TO 7
  317. 2960 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3360
  318. 2970 GOTO 3090
  319. 2980 FOR I=1 TO 7
  320. 2990 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3360
  321. 3000 GOTO 3090
  322. 3010 FOR I=1 TO 7
  323. 3020 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3360
  324. 3030 GOTO 3090
  325. 3040 FOR I=1 TO 7
  326. 3050 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3360
  327. 3060 GOTO 3090
  328. 3070 FOR I=1 TO 7
  329. 3080 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3360
  330. 3090 XS2=S2:GOTO 1040
  331. 3100 FOR I=1 TO 7
  332. 3110 LOCATE 9+I,5:PRINT TEMP$(I)
  333. 3120 NEXT I
  334. 3130 RETURN
  335. 3140 FOR I=1 TO 7
  336. 3150 LOCATE 9+I,14:PRINT TEMP$(I)
  337. 3160 NEXT I
  338. 3170 FOR I=1 TO 7
  339. 3180 LOCATE 9+I,26:PRINT COL$(I)
  340. 3190 NEXT I
  341. 3200 RETURN
  342. 3210 FOR I=1 TO 7
  343. 3220 LOCATE 9+I,32:PRINT TEMP$(I)
  344. 3230 NEXT I
  345. 3240 RETURN
  346. 3250 FOR I=1 TO 7
  347. 3260 LOCATE 9+I,42:PRINT TEMP$(I)
  348. 3270 NEXT I
  349. 3280 FOR I=1 TO 7
  350. 3290 LOCATE 9+I,54:PRINT COL$(I)
  351. 3300 NEXT I
  352. 3310 RETURN
  353. 3320 FOR I=1 TO 7
  354. 3330 LOCATE 9+I,60:PRINT TEMP$(I)
  355. 3340 NEXT I
  356. 3350 RETURN
  357. 3360 FOR I=1 TO 7
  358. 3370 LOCATE 9+I,70:PRINT TEMP$(I)
  359. 3380 NEXT I
  360. 3390 RETURN
  361. 4060 MO$=MID$(DATE$,1,2)
  362. 4070 DA$=MID$(DATE$,4,2)
  363. 4080 YR$=MID$(DATE$,9,2)
  364. 4081 YR4$=MID$(DATE$,7,4)
  365. 4090 MO=VAL(MO$)
  366. 4091 YR=VAL(YR$)
  367. 4092 YR4=VAL(YR4$)
  368. 4100 ON MO GOTO 4110,4120,4130,4140,4150,4160,4170,4180,4190,4200,4210,4220
  369. 4110 MO$="JANUARY":GOTO 4230
  370. 4120 MO$="FEBRUARY":GOTO 4230
  371. 4130 MO$="MARCH":GOTO 4230
  372. 4140 MO$="APRIL":GOTO 4230
  373. 4150 MO$="MAY":GOTO 4230
  374. 4160 MO$="JUNE":GOTO 4230
  375. 4170 MO$="JULY":GOTO 4230
  376. 4180 MO$="AUGUST":GOTO 4230
  377. 4190 MO$="SEPTEMBER":GOTO 4230
  378. 4200 MO$="OCTOBER":GOTO 4230
  379. 4210 MO$="NOVEMBER":GOTO 4230
  380. 4220 MO$="DECEMBER":GOTO 4230
  381. 4230 YEAR%=YR4
  382. 4233 MONTH%=MO
  383. 4235 DAY%=VAL(DA$)
  384. 4240 IF MONTH%=1 OR MONTH%=2 THEN 4250 ELSE 4270
  385. 4250 YEAR%=YEAR%-1
  386. 4260 MONTH%=MONTH%+12
  387. 4270 DOW.K%=DAY%+YEAR%+MONTH%*2+YEAR%\4+YEAR%\400+(MONTH%+1)*3\5+2-YEAR%\100
  388. 4330 DOW%=DOW.K% MOD 7
  389. 4360 IF DOW%=0 OR DOW%=1 THEN DOW%=DOW%+7
  390. 4370 DOW%=DOW%-1
  391. 4500 ON DOW% GOTO 4510,4520,4530,4540,4550,4560,4570
  392. 4510 DOW$="MONDAY":GOTO 4580
  393. 4520 DOW$="TUESDAY":GOTO 4580
  394. 4530 DOW$="WEDNESDAY":GOTO 4580
  395. 4540 DOW$="THURSDAY":GOTO 4580
  396. 4550 DOW$="FRIDAY":GOTO 4580
  397. 4560 DOW$="SATURDAY":GOTO 4580
  398. 4570 DOW$="SUNDAY":GOTO 4580
  399. 4580 LOCATE 22,29:PRINT DOW$;", ";MO$;" ";DA$;", ";YR4$;"     "
  400. 4590 RETURN
  401. 10000 RETURN 'IF TICKOFF < 0 THEN TICKOFF = TICKOFF + 1:RETURN
  402. 10003 IF ODD = 1 THEN SOUND 2000,1:ODD = 0:RETURN
  403. 10010 SOUND 5000,1:ODD = 1:RETURN
  404. 10090 CHIME = 0
  405. 10095 ODD = 0
  406. 10100 IF MIN = 15 THEN PLAY Q15$:TICKOFF = -2:RETURN
  407. 10110 IF MIN = 30 THEN PLAY Q15$+Q30$:TICKOFF = -5:RETURN
  408. 10120 IF MIN = 45 THEN PLAY Q15$+Q30$+Q15$:TICKOFF = -7:RETURN
  409. 10130 IF MIN = 0 THEN PLAY Q15$+Q30$+Q15$+Q30$:TICKOFF = -9 + -1*HOUR
  410. 10135 PLAY "mbP2"
  411. 10140 FOR II = 1 TO HOUR
  412. 10150 PLAY"MBO3CN0"
  413. 10160 NEXT II
  414. 10170 RETURN
  415.